;;;; Copyright 2009 Peter von Etter

;;;; This file is part of Autoproject

;;;; Autoproject is free software: you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation, either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; Autoproject is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with Autoproject.  If not, see
;;;; <http://www.gnu.org/licenses/>.

(in-package :autoproject.crud)

(defmacro with-crud ((crud &key transactionp) &body body)
  "Do stuff while the db of CRUD is active.  If TRANSACTIONP is non-nil,
evaluate BODY in a transaction."
  (cond ((eq transactionp t)
         `(call-with-db ,crud
                       (lambda ()
                         (call-with-transaction 
                          ,crud (lambda () ,@body)))))
        ((eq transactionp nil)
         `(call-with-db ,crud
                       (lambda () ,@body)))
        (t 
         `(if ,transactionp
              (call-with-db ,crud
                            (lambda ()
                              (call-with-transaction 
                               ,crud (lambda () ,@body))))
              (call-with-db ,crud
                            (lambda () ,@body))))))
        
(defmacro with-transaction (crud &body body)
  `(call-with-transaction ,crud (lambda () ,@body)))

(defmacro define-crud-accessors (special-var-name &optional (prefix "I-CRUD"))
  "Defines crud accessors for the lazy.  SPECIAL-VAR-NAME should be
bound to a crud instance."
  (flet ((p (name)
           (intern (string-upcase (format nil "~A-~A" prefix name)))))
    (let ((s special-var-name))
      `(progn
         (defun ,(p "READ") (table id)
           (crud-read ,s table id))
         (defun ,(p "READ-FROM-INSTANCE") (instance)
           (crud-read-from-instance ,s instance))

         (defun ,(p "CREATE") (table id values)           
           (crud-create ,s table id values))
         (defun ,(p "CREATE-FROM-INSTANCE") (instance) 
           (crud-create-from-instance ,s instance))

         (defun ,(p "DELETE") (table id)
           (crud-delete ,s table id))
         (defun ,(p "DELETE-FROM-INSTANCE") (instance)
           (crud-delete-from-instance ,s instance))
         
         (defun ,(p "UPDATE") (table id values)
           (crud-update ,s table id values))
         (defun ,(p "UPDATE-FROM-INSTANCE") (instance)
           (crud-update-from-instance ,s instance))

         (defun ,(p "MATCH") (instance)
           (crud-match ,s instance))

         (defun ,(p "SELECT") (select)
           (crud-select ,s select))
         (defun ,(p "SELECT-RAW") (select-or-query)
           (crud-select-raw ,s select-or-query))))))
      